R Notebook

# Please note that loading xlsx in R is really slow compared to csv
library(xlsx)
population_xls <- read.xlsx("./indicator_gapminder population.xlsx", encoding = "UTF-8",stringsAsFactors= F, sheetIndex = 1, as.data.frame = TRUE, header=TRUE)

fertility_xls <- read.xlsx("./indicator_undata total_fertility.xlsx", encoding = "UTF-8",stringsAsFactors= F, sheetIndex = 1, as.data.frame = TRUE, header=TRUE)

lifeexp_xls <- read.xlsx("./indicator_life_expectancy_at_birth.xlsx", encoding = "UTF-8", stringsAsFactors= F, sheetIndex = 1, as.data.frame = TRUE, header=TRUE)

# Load libraries
library(reshape)
library(gapminder)
library(dplyr)
library(ggplot2)
# Create a variable to keep only years 1962 to 2015
myvars <- paste("X", 1962:2015, sep="")
# Create 3 data frame with only years 1962 to 2015
population <- population_xls[c('Total.population',myvars)]
fertility <- fertility_xls[c('Total.fertility.rate',myvars)]
lifeexp <- lifeexp_xls[c('Life.expectancy',myvars)]
# Rename the first column as "Country"
colnames(population)[1] <- "Country"
colnames(fertility)[1] <- "Country"
colnames(lifeexp)[1] <- "Country"
# Remove empty lines that were created keeping only 275 countries
lifeexp <- lifeexp[1:275,]
population <- population[1:275,]
# Use reshape library to move the year dimension as a column
population_m <- melt(population, id=c("Country")) 
lifeexp_m <- melt(lifeexp, id=c("Country")) 
fertility_m <- melt(fertility, id=c("Country")) 
# Give a different name to each KPI (e.g. pop, life, fert)
colnames(population_m)[3] <- "pop"
colnames(lifeexp_m)[3] <- "life"
colnames(fertility_m)[3] <- "fert"
# Merge the 3 data frames into one
mydf <- merge(lifeexp_m, fertility_m, by=c("Country","variable"), header =T)
mydf <- merge(mydf, population_m, by=c("Country","variable"), header =T)
# The only piece of the puzzle missing is the continent name for each country for the color - use gapminder library to bring it
continent <- gapminder %>% group_by(continent, country) %>% distinct(country, continent)
continent <- data.frame(lapply(continent, as.character), stringsAsFactors=FALSE)
colnames(continent)[1] <- "Country"
# Filter out all countries that do not exist in the continent table
mydf_filter <- mydf %>% filter(Country %in% unique(continent$Country))
# Add the continent column to finalize the data set
mydf_filter <- merge(mydf_filter, continent, by=c("Country"), header =T)
# Do some extra cleaning (e.g. remove N/A lines, remove factors, and convert KPIs into numerical values)
mydf_filter[is.na(mydf_filter)] <- 0
mydf_filter <- data.frame(lapply(mydf_filter, as.character), stringsAsFactors=FALSE)
mydf_filter$variable <- as.numeric(as.character(gsub("X","",mydf_filter$variable)))
mydf_filter$pop <- round(as.numeric(as.character(mydf_filter$pop))/1000000,1)
mydf_filter$fert <- as.numeric(as.character(mydf_filter$fert))
mydf_filter$life <- as.numeric(as.character(mydf_filter$life))

# Load libraries
library(ggplot2)
library(gganimate)

# Create the plot with years as frame, limiting y axis from 30 years to 100
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = variable)) +
  geom_point()+ ylim(30,100)  + labs(x="Fertility Rate", y = "Life expectancy at birth (years)", caption = "(Based on data from Hans Rosling - gapminder.com)", color = 'Continent',size = "Population (millions)") + 
  scale_color_brewer(type = 'div', palette = 'Spectral') 

# Add a global theme
theme_set(theme_grey()+ theme(legend.box.background = element_rect(),legend.box.margin = margin(6, 6, 6, 6)) )

# Generate the Visual with 0.2 animation speed and a GIF output
# gganimate(p, interval = .2, "output.gif")

anim_save("output.gif")

# Load libraries
library(plotly)

Attaching package: 㤼㸱plotly㤼㸲

The following object is masked from 㤼㸱package:reshape㤼㸲:

    rename

The following object is masked from 㤼㸱package:ggplot2㤼㸲:

    last_plot

The following object is masked from 㤼㸱package:stats㤼㸲:

    filter

The following object is masked from 㤼㸱package:graphics㤼㸲:

    layout

library(ggplot2)
# Create the plot
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = variable)) +
  geom_point()+ ylim(30,100)  + labs(x="Fertility Rate", y = "Life expectancy at birth (years)", color = 'Continent',size = "Population (millions)") + 
  scale_color_brewer(type = 'div', palette = 'Spectral')

# Generate the Visual and a HTML output
ggp <- ggplotly(p, height = 900, width = 900) %>%
  animation_opts(frame = 100,
                 easing = "linear",
                 redraw = FALSE)
ggp

htmlwidgets::saveWidget(ggp, "index.html")

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpTb3VyY2U6IGh0dHBzOi8vdG93YXJkc2RhdGFzY2llbmNlLmNvbS9ob3ctdG8tYnVpbGQtYW5pbWF0ZWQtY2hhcnRzLWxpa2UtaGFucy1yb3NsaW5nLWRvaW5nLWl0LWFsbC1pbi1yLTU3MGVmYzZiYTM4Mg0KDQpHaXRodWI6IGh0dHBzOi8vZ2l0aHViLmNvbS90cmlzdGFuZ2EvYW5pbWF0ZWRjaGFydHMvYmxvYi9tYXN0ZXIvQW5pbWF0ZWRfQ2hhcnRzLlINCg0KIyMgTG9hZGluZyB0aGUgZGF0YSB3aXRoIHhsc3ggbGlicmFyeSAocmVwbGFjZSDigJguLuKAmSBieSB5b3VyIGZvbGRlcikNCg0KYGBge3J9DQojIFBsZWFzZSBub3RlIHRoYXQgbG9hZGluZyB4bHN4IGluIFIgaXMgcmVhbGx5IHNsb3cgY29tcGFyZWQgdG8gY3N2DQpsaWJyYXJ5KHhsc3gpDQoNCnBvcHVsYXRpb25feGxzIDwtIHJlYWQueGxzeCgiLi9pbmRpY2F0b3JfZ2FwbWluZGVyIHBvcHVsYXRpb24ueGxzeCIsIGVuY29kaW5nID0gIlVURi04IixzdHJpbmdzQXNGYWN0b3JzPSBGLCBzaGVldEluZGV4ID0gMSwgYXMuZGF0YS5mcmFtZSA9IFRSVUUsIGhlYWRlcj1UUlVFKQ0KDQpmZXJ0aWxpdHlfeGxzIDwtIHJlYWQueGxzeCgiLi9pbmRpY2F0b3JfdW5kYXRhIHRvdGFsX2ZlcnRpbGl0eS54bHN4IiwgZW5jb2RpbmcgPSAiVVRGLTgiLHN0cmluZ3NBc0ZhY3RvcnM9IEYsIHNoZWV0SW5kZXggPSAxLCBhcy5kYXRhLmZyYW1lID0gVFJVRSwgaGVhZGVyPVRSVUUpDQoNCmxpZmVleHBfeGxzIDwtIHJlYWQueGxzeCgiLi9pbmRpY2F0b3JfbGlmZV9leHBlY3RhbmN5X2F0X2JpcnRoLnhsc3giLCBlbmNvZGluZyA9ICJVVEYtOCIsIHN0cmluZ3NBc0ZhY3RvcnM9IEYsIHNoZWV0SW5kZXggPSAxLCBhcy5kYXRhLmZyYW1lID0gVFJVRSwgaGVhZGVyPVRSVUUpDQpgYGANCg0KDQojIyBDbGVhbiBhbmQgbWVyZ2UgdGhlIGRhdGEgd2l0aCBgcmVzaGFwZWAgYW5kIGBkcGx5cmAgbGlicmFyaWVzDQoNCmBgYHtyfQ0KIyBMb2FkIGxpYnJhcmllcw0KbGlicmFyeShyZXNoYXBlKQ0KbGlicmFyeShnYXBtaW5kZXIpDQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQojIENyZWF0ZSBhIHZhcmlhYmxlIHRvIGtlZXAgb25seSB5ZWFycyAxOTYyIHRvIDIwMTUNCm15dmFycyA8LSBwYXN0ZSgiWCIsIDE5NjI6MjAxNSwgc2VwPSIiKQ0KIyBDcmVhdGUgMyBkYXRhIGZyYW1lIHdpdGggb25seSB5ZWFycyAxOTYyIHRvIDIwMTUNCnBvcHVsYXRpb24gPC0gcG9wdWxhdGlvbl94bHNbYygnVG90YWwucG9wdWxhdGlvbicsbXl2YXJzKV0NCmZlcnRpbGl0eSA8LSBmZXJ0aWxpdHlfeGxzW2MoJ1RvdGFsLmZlcnRpbGl0eS5yYXRlJyxteXZhcnMpXQ0KbGlmZWV4cCA8LSBsaWZlZXhwX3hsc1tjKCdMaWZlLmV4cGVjdGFuY3knLG15dmFycyldDQojIFJlbmFtZSB0aGUgZmlyc3QgY29sdW1uIGFzICJDb3VudHJ5Ig0KY29sbmFtZXMocG9wdWxhdGlvbilbMV0gPC0gIkNvdW50cnkiDQpjb2xuYW1lcyhmZXJ0aWxpdHkpWzFdIDwtICJDb3VudHJ5Ig0KY29sbmFtZXMobGlmZWV4cClbMV0gPC0gIkNvdW50cnkiDQojIFJlbW92ZSBlbXB0eSBsaW5lcyB0aGF0IHdlcmUgY3JlYXRlZCBrZWVwaW5nIG9ubHkgMjc1IGNvdW50cmllcw0KbGlmZWV4cCA8LSBsaWZlZXhwWzE6Mjc1LF0NCnBvcHVsYXRpb24gPC0gcG9wdWxhdGlvblsxOjI3NSxdDQojIFVzZSByZXNoYXBlIGxpYnJhcnkgdG8gbW92ZSB0aGUgeWVhciBkaW1lbnNpb24gYXMgYSBjb2x1bW4NCnBvcHVsYXRpb25fbSA8LSBtZWx0KHBvcHVsYXRpb24sIGlkPWMoIkNvdW50cnkiKSkgDQpsaWZlZXhwX20gPC0gbWVsdChsaWZlZXhwLCBpZD1jKCJDb3VudHJ5IikpIA0KZmVydGlsaXR5X20gPC0gbWVsdChmZXJ0aWxpdHksIGlkPWMoIkNvdW50cnkiKSkgDQojIEdpdmUgYSBkaWZmZXJlbnQgbmFtZSB0byBlYWNoIEtQSSAoZS5nLiBwb3AsIGxpZmUsIGZlcnQpDQpjb2xuYW1lcyhwb3B1bGF0aW9uX20pWzNdIDwtICJwb3AiDQpjb2xuYW1lcyhsaWZlZXhwX20pWzNdIDwtICJsaWZlIg0KY29sbmFtZXMoZmVydGlsaXR5X20pWzNdIDwtICJmZXJ0Ig0KIyBNZXJnZSB0aGUgMyBkYXRhIGZyYW1lcyBpbnRvIG9uZQ0KbXlkZiA8LSBtZXJnZShsaWZlZXhwX20sIGZlcnRpbGl0eV9tLCBieT1jKCJDb3VudHJ5IiwidmFyaWFibGUiKSwgaGVhZGVyID1UKQ0KbXlkZiA8LSBtZXJnZShteWRmLCBwb3B1bGF0aW9uX20sIGJ5PWMoIkNvdW50cnkiLCJ2YXJpYWJsZSIpLCBoZWFkZXIgPVQpDQojIFRoZSBvbmx5IHBpZWNlIG9mIHRoZSBwdXp6bGUgbWlzc2luZyBpcyB0aGUgY29udGluZW50IG5hbWUgZm9yIGVhY2ggY291bnRyeSBmb3IgdGhlIGNvbG9yIC0gdXNlIGdhcG1pbmRlciBsaWJyYXJ5IHRvIGJyaW5nIGl0DQpjb250aW5lbnQgPC0gZ2FwbWluZGVyICU+JSBncm91cF9ieShjb250aW5lbnQsIGNvdW50cnkpICU+JSBkaXN0aW5jdChjb3VudHJ5LCBjb250aW5lbnQpDQpjb250aW5lbnQgPC0gZGF0YS5mcmFtZShsYXBwbHkoY29udGluZW50LCBhcy5jaGFyYWN0ZXIpLCBzdHJpbmdzQXNGYWN0b3JzPUZBTFNFKQ0KY29sbmFtZXMoY29udGluZW50KVsxXSA8LSAiQ291bnRyeSINCiMgRmlsdGVyIG91dCBhbGwgY291bnRyaWVzIHRoYXQgZG8gbm90IGV4aXN0IGluIHRoZSBjb250aW5lbnQgdGFibGUNCm15ZGZfZmlsdGVyIDwtIG15ZGYgJT4lIGZpbHRlcihDb3VudHJ5ICVpbiUgdW5pcXVlKGNvbnRpbmVudCRDb3VudHJ5KSkNCiMgQWRkIHRoZSBjb250aW5lbnQgY29sdW1uIHRvIGZpbmFsaXplIHRoZSBkYXRhIHNldA0KbXlkZl9maWx0ZXIgPC0gbWVyZ2UobXlkZl9maWx0ZXIsIGNvbnRpbmVudCwgYnk9YygiQ291bnRyeSIpLCBoZWFkZXIgPVQpDQojIERvIHNvbWUgZXh0cmEgY2xlYW5pbmcgKGUuZy4gcmVtb3ZlIE4vQSBsaW5lcywgcmVtb3ZlIGZhY3RvcnMsIGFuZCBjb252ZXJ0IEtQSXMgaW50byBudW1lcmljYWwgdmFsdWVzKQ0KbXlkZl9maWx0ZXJbaXMubmEobXlkZl9maWx0ZXIpXSA8LSAwDQpteWRmX2ZpbHRlciA8LSBkYXRhLmZyYW1lKGxhcHBseShteWRmX2ZpbHRlciwgYXMuY2hhcmFjdGVyKSwgc3RyaW5nc0FzRmFjdG9ycz1GQUxTRSkNCm15ZGZfZmlsdGVyJHZhcmlhYmxlIDwtIGFzLm51bWVyaWMoYXMuY2hhcmFjdGVyKGdzdWIoIlgiLCIiLG15ZGZfZmlsdGVyJHZhcmlhYmxlKSkpDQpteWRmX2ZpbHRlciRwb3AgPC0gcm91bmQoYXMubnVtZXJpYyhhcy5jaGFyYWN0ZXIobXlkZl9maWx0ZXIkcG9wKSkvMTAwMDAwMCwxKQ0KbXlkZl9maWx0ZXIkZmVydCA8LSBhcy5udW1lcmljKGFzLmNoYXJhY3RlcihteWRmX2ZpbHRlciRmZXJ0KSkNCm15ZGZfZmlsdGVyJGxpZmUgPC0gYXMubnVtZXJpYyhhcy5jaGFyYWN0ZXIobXlkZl9maWx0ZXIkbGlmZSkpDQpgYGANCg0KIyMgIEJ1aWxkIHRoZSBjaGFydCB3aXRoIGdnYW5pbWF0ZSBhbmQgZ2VuZXJhdGUgYSBHSUYgZmlsZSB0byBzaGFyZSB3aXRoIHlvdXIgZnJpZW5kcw0KDQoNCmBgYHtyfQ0KIyBMb2FkIGxpYnJhcmllcw0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShnZ2FuaW1hdGUpDQoNCiMgQ3JlYXRlIHRoZSBwbG90IHdpdGggeWVhcnMgYXMgZnJhbWUsIGxpbWl0aW5nIHkgYXhpcyBmcm9tIDMwIHllYXJzIHRvIDEwMA0KcCA8LSBnZ3Bsb3QobXlkZl9maWx0ZXIsIGFlcyhmZXJ0LCBsaWZlLCBzaXplID0gcG9wLCBjb2xvciA9IGNvbnRpbmVudCwgZnJhbWUgPSB2YXJpYWJsZSkpICsNCiAgZ2VvbV9wb2ludCgpKyB5bGltKDMwLDEwMCkgICsgbGFicyh4PSJGZXJ0aWxpdHkgUmF0ZSIsIHkgPSAiTGlmZSBleHBlY3RhbmN5IGF0IGJpcnRoICh5ZWFycykiLCBjYXB0aW9uID0gIihCYXNlZCBvbiBkYXRhIGZyb20gSGFucyBSb3NsaW5nIC0gZ2FwbWluZGVyLmNvbSkiLCBjb2xvciA9ICdDb250aW5lbnQnLHNpemUgPSAiUG9wdWxhdGlvbiAobWlsbGlvbnMpIikgKyANCiAgc2NhbGVfY29sb3JfYnJld2VyKHR5cGUgPSAnZGl2JywgcGFsZXR0ZSA9ICdTcGVjdHJhbCcpIA0KDQojIEFkZCBhIGdsb2JhbCB0aGVtZQ0KdGhlbWVfc2V0KHRoZW1lX2dyZXkoKSArIA0KICAgICAgICAgICAgICB0aGVtZShsZWdlbmQuYm94LmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoKSwgDQogICAgICAgICAgICAgICAgICAgIGxlZ2VuZC5ib3gubWFyZ2luID0gbWFyZ2luKDYsIDYsIDYsIDYpKSApDQoNCiMgR2VuZXJhdGUgdGhlIFZpc3VhbCB3aXRoIDAuMiBhbmltYXRpb24gc3BlZWQgYW5kIGEgR0lGIG91dHB1dA0KIyBnZ2FuaW1hdGUocCwgaW50ZXJ2YWwgPSAuMiwgIm91dHB1dC5naWYiKQ0KDQphbmltX3NhdmUoIm91dHB1dC5naWYiKQ0KDQpgYGANCg0KDQoNCmBgYHtyfQ0KIyBMb2FkIGxpYnJhcmllcw0KbGlicmFyeShwbG90bHkpDQpsaWJyYXJ5KGdncGxvdDIpDQoNCiMgQ3JlYXRlIHRoZSBwbG90DQpwIDwtIGdncGxvdChteWRmX2ZpbHRlciwgYWVzKGZlcnQsIGxpZmUsIHNpemUgPSBwb3AsIGNvbG9yID0gY29udGluZW50LCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZnJhbWUgPSB2YXJpYWJsZSkpICsNCiAgZ2VvbV9wb2ludCgpKyB5bGltKDMwLDEwMCkgICsgDQogICAgbGFicyh4PSJGZXJ0aWxpdHkgUmF0ZSIsIHkgPSAiTGlmZSBleHBlY3RhbmN5IGF0IGJpcnRoICh5ZWFycykiLCBjb2xvciA9ICdDb250aW5lbnQnLHNpemUgPSAiUG9wdWxhdGlvbiAobWlsbGlvbnMpIikgKyANCiAgc2NhbGVfY29sb3JfYnJld2VyKHR5cGUgPSAnZGl2JywgcGFsZXR0ZSA9ICdTcGVjdHJhbCcpDQpgYGANCg0KYGBge3J9DQojIEdlbmVyYXRlIHRoZSBWaXN1YWwgYW5kIGEgSFRNTCBvdXRwdXQNCmdncCA8LSBnZ3Bsb3RseShwLCBoZWlnaHQgPSA5MDAsIHdpZHRoID0gOTAwKSAlPiUNCiAgYW5pbWF0aW9uX29wdHMoZnJhbWUgPSAxMDAsDQogICAgICAgICAgICAgICAgIGVhc2luZyA9ICJsaW5lYXIiLA0KICAgICAgICAgICAgICAgICByZWRyYXcgPSBGQUxTRSkNCmdncA0KaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQoZ2dwLCAiaW5kZXguaHRtbCIpDQpgYGANCg0K